home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
MATHLIB2
/
HYPERBOL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-10-14
|
4KB
|
131 lines
Unit HYPERBOL;
(* Bibliotheque mathematique des fonctions hyperboliques *)
(* JD GAYRARD mars 94 *)
(* revision 1.0 de Oct 95 pour :
- correction de arg_th (test valeur negative) *)
{$G+}
{$N+}
{$E-}
interface
uses MATHLIB;
const author = 'GAYRARD J-D';
version = 'ver 1.0 - 10/95';
const TANH_MAX = 13; (* argument maximum de th(x) pour type real *)
SQR_MAX = 1.3E+19; (* argument maximum d'un carre pour type real *)
EXP_MAX = 88.0288; (* argument maximum de exp pour type real *)
(* fonctions trigonometriques directes *)
function ch(x : float): float;
function sh(x : float): float;
function th(x : float): float;
(* fonctions trigonometriques inverses *)
function arg_ch(x : float): float;
function arg_sh(x : float): float;
function arg_th(x : float): float;
implementation
(* fonctions trigonometriques directes *)
function ch(x : float): float;
(* retourne le cosinus hyperbolique de l'argument *)
(* ch(x) = [exp(x) + exp(-x)] / 2 *)
begin
if (x > EXP_MAX) or (x < - EXP_MAX)
then begin
writeln('******** Fonction ch ********');
writeln('********* OVERFLOW **********');
halt
end
else begin
x := exp(x);
ch := 0.5 * (x + 1.0 / x)
end
end;
function sh(x : float): float;
(* retourne le sinus hyperbolique de l'argument *)
(* sh(x) = [exp(x) - exp(-x)] / 2 *)
begin
if (x > EXP_MAX) or (x < -EXP_MAX)
then begin
writeln('******** Fonction sh ********');
writeln('********* UNDERFLOW *********');
halt
end
else begin
x := exp(x);
sh := 0.5 * (x - (1.0 / x))
end
end;
function th(x : float): float;
(* retourne la tangente hyperbolique de l'argument *)
(* th(x) = sh(x) / ch(x) *)
(* th(x) = [exp(x) - exp(x)] / [exp(x) + exp(-x)] *)
begin
if (x > TANH_MAX) or (x < - TANH_MAX)
then if x > 0.0 then th := 1.0
else th := - 1.0
else th := sh(x) / ch(x)
end;
(* fonctions trigonometriques inverses *)
function arg_ch(x : float): float;
(* retourne l'arc cosinus hyperbolique de l'argument *)
(* ________ *)
(* arg ch(x) = ln ( x + V x.x - 1 ) fonction definie pour x >=1 *)
begin
if x < 1.0
then begin
writeln('******** Fonction arg_ch ********');
writeln('********** RANGE ERROR **********');
halt
end
else if x > SQR_MAX
then begin
writeln('******** Fonction arg_ch ********');
writeln('************ OVERFLOW ************');
halt
end
else arg_ch := ln(x + sqrt(x * x - 1.0))
end;
function arg_sh(x : float): float;
(* retourne l'arc sinus hyperbolique de l'argument *)
(* _________ *)
(* arg sh(x) = ln ( x + V x.x + 1 ) *)
begin
if (x < -SQR_MAX) or (x > SQR_MAX)
then begin
writeln('******** Fonction Arg_sh ********');
writeln('************ OVERFLOW ***********');
halt
end
else arg_sh := ln(x + sqrt(x * x + 1.0))
end;
function arg_th(x : float): float;
(* retourne l'arc tangente hyperbolique de l'argument *)
(* arg th(x) = 1/2 ln [ (1 + x) / (1 - x) fonction definie pour |x| < 1 *)
begin
if (x <= -1.0) or (x >= 1.0)
then begin
writeln('******** Fonction Arg_th ********');
writeln('********** RANGE ERROR **********');
halt
end
else arg_th := signe(0.5 * ln((1.0 + x) / (1.0 - x)),x)
end;
end.